home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / rrect.cls < prev    next >
Encoding:
Visual Basic class definition  |  2004-03-05  |  14.8 KB  |  420 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Rectangle"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15. '/******************************************************************/
  16. '/*                                                                */
  17. '/*                      TurboCAD for Windows                      */
  18. '/*                   Copyright (c) 1993 - 2001                    */
  19. '/*             International Microcomputer Software, Inc.         */
  20. '/*                            (IMSI)                              */
  21. '/*                      All rights reserved.                      */
  22. '/*                                                                */
  23. '/******************************************************************/
  24.  
  25. 'DBAPI constants
  26. Const gkGraphic = 11
  27. Const gkArc = 2
  28. Const gkText = 6
  29. Const gfCosmetic = 128&
  30.  
  31. 'Useful math constants
  32. Const Pi# = 3.14159265
  33.  
  34. 'Real variant types!
  35. Const typeEmpty = 0
  36. Const typeInteger = 2
  37. Const typeLong = 3
  38. Const typeSingle = 4
  39. Const typeDouble = 5
  40. Const typeCurrency = 6
  41. Const typeDate = 7
  42. Const typeString = 8
  43. Const typeObject = 9
  44. Const typeBoolean = 11
  45. Const typeVariant = 12
  46. Const typeIntegerEnum = typeInteger + 100
  47. Const typeLongEnum = typeLong + 100
  48. Const typeStringEnum = typeString + 100
  49.  
  50. 'Stock property pages
  51. Const ppStockPen = 1
  52. Const ppStockBrush = 2
  53. Const ppStockText = 4
  54. Const ppStockInsert = 8
  55. Const ppStockViewport = 16
  56. Const ppStockAuto = 32
  57.  
  58. 'Property Ids
  59. Const idRoundness = 1
  60.  
  61. 'Property enums
  62.  
  63. 'Number of properties, pages, wizards
  64. Const NUM_PROPERTIES = 1
  65. Const NUM_PAGES = 1
  66. Const NUM_WIZARDS = 0
  67. Const formCaption = "Round Rectangle"
  68. Private Sub Class_Initialize()
  69.     'Initialize class variables
  70. End Sub
  71.  
  72. 'Returns the user-visible description of this RegenMethod
  73. Public Property Get Description() As String
  74.     Description = "SDK RoundRectangle (VB sample)"
  75. End Property
  76.  
  77. 'Returns the persistent class id for this RegenMethod's property section
  78. Public Property Get ClassID() As String
  79.     ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
  80. End Property
  81.  
  82. 'Retrieve types and names
  83. Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
  84.     IDs As Variant, Defaults As Variant) As Long
  85.     ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
  86.         IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
  87.     Names(0) = "Roundness"
  88.     Types(0) = typeDouble
  89.     IDs(0) = idRoundness
  90.     Defaults(0) = 50#
  91.     GetPropertyInfo = NUM_PROPERTIES
  92. End Function
  93.  
  94. 'Get the number of property pages supporting this RegenMethod
  95. Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
  96.     Names As Variant) As Long
  97.     ReDim Names(NUM_PAGES)
  98.  
  99.     'Need the form
  100. '    Load frmRRect
  101. '    Names(0) = frmRRect.Caption
  102. '    Unload frmRRect
  103.     Names(0) = formCaption
  104.     StockPages = ppStockBrush + ppStockPen + ppStockAuto
  105.     GetPageInfo = NUM_PAGES
  106. End Function
  107.  
  108. Public Function GetWizardInfo(Names As Variant) As Long
  109.     ReDim Names(NUM_WIZARDS)
  110.     GetWizardInfo = NUM_WIZARDS
  111. End Function
  112.  
  113. 'Enumerate the names and values of a specified property
  114. Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
  115.     GetEnumNames = 0
  116. End Function
  117.  
  118. Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
  119.         'Set up error function
  120.         On Error GoTo Failed
  121.  
  122.         Dim Roundness#
  123.         If SaveProperties Then
  124.             'OK button on property page was clicked
  125.             'Form is still loaded
  126.             With frmRRect
  127.                 'Need On Error statement for the case where you have
  128.                 'RRect Turbo Shape and ahother "shape" selected
  129.                 On Error Resume Next
  130.  
  131.                 'When the property page is closed, transfer the numeric
  132.                 'roundness value from the TextBox to the Graphic
  133.                 'Get the value as a double-precision number
  134.                 Roundness# = CDbl(.txtRoundness.Text)
  135.                 'Make sure it's between 0 and 100
  136.                 If Roundness# < 0# Then Roundness# = 0#
  137.                 If Roundness# > 100# Then Roundness# = 100#
  138.                 'Set the roundness property value in the Graphic
  139.                 Graphic.Properties("Roundness") = Roundness#
  140.             End With
  141.         Else
  142.             'Property page is about to be opened
  143.             'Make sure the form is loaded
  144.             Load frmRRect
  145.             With frmRRect
  146.                 'If more than one RRect is selected and they do not
  147.                 'have the same properties, don't set up this field
  148.                 On Error GoTo NoRType
  149.  
  150.                 'When the property page is opening, transfer the numeric
  151.                 'roundness value from the Graphic to the TextBox
  152.                 'Get the roundness property value from the Graphic
  153.                 Roundness# = Graphic.Properties("Roundness")
  154.                 'Set the TextBox control's text
  155.                 .txtRoundness.Text = Roundness#
  156. NoRType:
  157.             End With
  158.         End If
  159.  
  160.         PageControls = True
  161.         Exit Function
  162.  
  163. Failed:
  164.         'For debugging purposes, report that an error occurred
  165.         If Err.Number <> 0 Then
  166.             MsgBox "Error in PageControls: " & Err.Description
  167.         End If
  168.  
  169.         'Return false if an error occurred
  170.         PageControls = False
  171. End Function
  172.  
  173. Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
  174.         'Done with form
  175.         Unload frmRRect
  176. End Function
  177.  
  178. Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
  179.     With frmRRect
  180.         .Show vbModal
  181.         PropertyPages = Not .DialogCanceled
  182.     End With
  183. End Function
  184.  
  185. Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
  186.     Wizard = False
  187. End Function
  188.  
  189. 'Called when vertex has been moved, or other geometry change
  190. Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
  191.     'Do nothing
  192.     'Regen Graphic
  193. End Function
  194.  
  195. 'Called when vertex is moved, or other geometry change
  196. Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
  197.     'OK to continue with change
  198.     OnGeometryChanging = True
  199. End Function
  200.  
  201. Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
  202.     If boolCopy Then
  203.         'Vertices are already added for us...
  204.         OnNewGraphic = True
  205.         Exit Function
  206.     End If
  207.  
  208.     On Error GoTo Failed
  209.     'New Graphic being created
  210.     'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
  211.     'First Vertex is "lower left" corner
  212.     grfThis.Vertices.Add -1#, -0.5, 0#, False, True, False, False, False
  213.     'Second Vertex is "upper right" corner
  214.     grfThis.Vertices.Add 1#, 0.5, 0#, False, True, False, False, False
  215.     'Third Vertex is rounding handle (calculated)
  216.     Dim R#, Roundness#, Offset#
  217.     Roundness# = grfThis.Properties("Roundness")
  218.     R# = 0.5 * Roundness# / 100#
  219.     Offset# = 0.1 * R#
  220.     grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, False, False, False, False
  221.     'Fourth Vertex is rounding handle (editable)
  222.     grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, True, False, True, False
  223.     grfThis.Properties("LimitVertices") = 4
  224.     OnNewGraphic = True
  225.     Exit Function
  226.  
  227. Failed:
  228.     'Return false on failure
  229.     OnNewGraphic = False
  230. End Function
  231.  
  232. 'Function called whenever a copy of a graphic is being made
  233. Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
  234.     'Return false on failure
  235.     OnCopyGraphic = True
  236. End Function
  237.  
  238. 'Notification function called after graphic property is saved
  239. Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
  240.         ValueOld As Variant, ValueNew As Variant)
  241.     'Do nothing
  242. End Function
  243.  
  244. 'Notification function called when graphic property is saved
  245. Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
  246.         ValueOld As Variant, ValueNew As Variant) As Boolean
  247.     'OK to proceed
  248.     OnPropertyChanging = True
  249. End Function
  250.  
  251. 'Notification function called when graphic property is retrieved
  252. Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
  253.     'Do nothing
  254. End Function
  255.  
  256. 'Called when we need to update our object
  257. Public Function Regen(ByVal grfThis As Object)
  258.         'Setup error handler
  259.         On Error GoTo Failed
  260.  
  261.         'Set up lock (prevent recursion)
  262.         Dim LockCount&
  263.         LockCount& = grfThis.RegenLock
  264.  
  265.         'Setup error handler (make sure lock is removed)
  266.         On Error GoTo FailedLock
  267.         If LockCount& = 0 Then
  268.             'Delete any previous cosmetic children
  269.             grfThis.Graphics.Clear gfCosmetic
  270.  
  271.             Dim boolHandleMoved As Boolean
  272.  
  273.  
  274.             'Calculate height, width and radius of corners
  275.             Dim W#, H#, R#, Roundness#
  276.             With grfThis.Vertices
  277.                 If (Abs(.Item(2).X - .Item(3).X) < 0.000001 And _
  278.                     Abs(.Item(2).Y - .Item(3).Y) < 0.000001) Then
  279.                     boolHandleMoved = False
  280.                 Else
  281.                     boolHandleMoved = True
  282.                 End If
  283.                 W# = Abs(.Item(1).X - .Item(0).X)
  284.                 H# = Abs(.Item(1).Y - .Item(0).Y)
  285.             End With
  286.             'Radius of arcs is based on minimum of width and height
  287.             If W# < H# Then
  288.                 R# = W# / 2#
  289.             Else
  290.                 R# = H# / 2#
  291.             End If
  292.             'Adjust radius for roundness
  293.             If boolHandleMoved Then
  294.                 Roundness# = Abs(grfThis.Vertices(2).X - grfThis.Vertices(3).X)
  295.                 Roundness# = Roundness# * 100# / R#
  296.                 If Roundness# > 100# Then Roundness# = 100#
  297.                 'Relocate handle
  298.  
  299.                 'Update property to reflect handle location
  300.                 grfThis.Properties("Roundness") = Roundness#
  301.             Else
  302.                 Roundness# = grfThis.Properties("Roundness")
  303.                 If Roundness# < 0# Then Roundness# = 0#
  304.                 If Roundness# > 100# Then Roundness# = 100#
  305.             End If
  306.             R# = R# * Roundness# / 100#
  307.  
  308.             'Add child Graphics
  309.             Dim grfChild As Object
  310.             Dim X0#, Y0#, X1#, Y1#, T#
  311.             With grfThis.Vertices
  312.                 X0# = .Item(0).X
  313.                 Y0# = .Item(0).Y
  314.                 X1# = .Item(1).X
  315.                 Y1# = .Item(1).Y
  316.                 'Make sure X0 < X1
  317.                 If (X0# > X1#) Then
  318.                     T# = X0#
  319.                     X0# = X1#
  320.                     X1# = T#
  321.                 End If
  322.                 'Make sure Y0 < Y1
  323.                 If (Y0# > Y1#) Then
  324.                     T# = Y0#
  325.                     Y0# = Y1#
  326.                     Y1# = T#
  327.                 End If
  328.             End With
  329.             If R# = 0# Then
  330.                 'No rounded corners
  331.                 'All children are cosmetic
  332.                 Set grfChild = grfThis.Graphics.Add(gkGraphic)
  333.                 grfChild.Cosmetic = True
  334.                 'Now add vertices to the child
  335.                 With grfChild.Vertices
  336.                     .Add X0#, Y0#, 0
  337.                     .Add X0#, Y1#, 0, True
  338.                     .Add X1#, Y1#, 0, True
  339.                     .Add X1#, Y0#, 0, True
  340.                     'Close the rectangle
  341.                     .AddClose PenDown:=True 'PenDown
  342.                 End With
  343.             Else
  344.                 'Rounded corners
  345.                 'We'll make 4 line children and 4 arc children
  346.                 'First line
  347.                 'All children are cosmetic
  348.                 Set grfChild = grfThis.Graphics.Add(gkGraphic)
  349.                 grfChild.Cosmetic = True
  350.                 'Now add vertices to the child
  351.                 With grfChild.Vertices
  352.                     .Add X0# + R#, Y0#, 0
  353.                     .Add X1# - R#, Y0#, 0, True
  354.                 End With
  355.                 'First arc
  356.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  357.                 grfChild.Cosmetic = True
  358.                 grfChild.ArcSet X1# - R#, Y0# + R#, 0#, R#, , 1.5 * Pi#, 0#
  359.                 'Second line
  360.                 Set grfChild = grfThis.Graphics.Add(gkGraphic)
  361.                 grfChild.Cosmetic = True
  362.                 With grfChild.Vertices
  363.                     .Add X1#, Y0# + R#, 0
  364.                     .Add X1#, Y1# - R#, 0, True
  365.                 End With
  366.                 'Second arc
  367.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  368.                 grfChild.Cosmetic = True
  369.                 grfChild.ArcSet X1# - R#, Y1# - R#, 0#, R#, , 0#, 0.5 * Pi#
  370.                 'Third line
  371.                 Set grfChild = grfThis.Graphics.Add(gkGraphic)
  372.                 grfChild.Cosmetic = True
  373.                 With grfChild.Vertices
  374.                     .Add X1# - R#, Y1#, 0
  375.                     .Add X0# + R#, Y1#, 0, True
  376.                 End With
  377.                 'Third arc
  378.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  379.                 grfChild.Cosmetic = True
  380.                 grfChild.ArcSet X0# + R#, Y1# - R#, 0#, R#, , 0.5 * Pi#, Pi#
  381.                 'Fourth line
  382.                 Set grfChild = grfThis.Graphics.Add(gkGraphic)
  383.                 grfChild.Cosmetic = True
  384.                 With grfChild.Vertices
  385.                     .Add X0#, Y1# - R#, 0
  386.                     .Add X0#, Y0# + R#, 0, True
  387.                 End With
  388.                 'Fourth arc
  389.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  390.                 grfChild.Cosmetic = True
  391.                 grfChild.ArcSet X0# + R#, Y0# + R#, 0#, R#, , Pi#, 1.5 * Pi#
  392.             End If
  393.  
  394.             'Add visible child Graphics
  395.         End If
  396.  
  397.         grfThis.RegenUnlock
  398.         'grfThis.Application.PopVertexDefaults
  399.         Exit Function
  400.  
  401. FailedLock:
  402.         'Remove lock
  403.         grfThis.RegenUnlock
  404.  
  405. Failed:
  406.         'grfThis.Application.PopVertexDefaults
  407.  
  408.         If Err.Number <> 0 Then
  409. '            MsgBox "Regen error: " & Err.Description
  410.         End If
  411. End Function
  412.  
  413. Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
  414.     'Return True if we did the redraw (no further processing necessary, no children will be drawn).
  415.     'Since this is just a test, we return False to let TurboCAD do the drawing operation.
  416.     Draw = False
  417. End Function
  418.  
  419.  
  420.